home *** CD-ROM | disk | FTP | other *** search
/ Programmer Power Tools / Programmer Power Tools.iso / surfmodl / surfm203.arc / SURFSRC.ARC / FILLSURF.INC < prev    next >
Encoding:
Text File  |  1987-01-10  |  3.5 KB  |  100 lines
  1. procedure BADSURF;
  2.  
  3. { A bad surface was attempted to be plotted. Explain why and halt. }
  4. begin
  5.   exgraphic;
  6.   writeln ('Error: You have attempted to plot a concave surface.');
  7.   writeln ('  This surface should be broken into at least two smaller');
  8.   writeln ('  surfaces. Alternatively, you may possibly be able to');
  9.   writeln ('  plot this surface anyway from a different angle or');
  10.   writeln ('  with a lower magnification factor.');
  11.   halt;
  12. end;  { procedure BADSURF }
  13.  
  14.  
  15. procedure FILLSURF (Surf, Color: integer; Shade: real);
  16.  
  17. { Draw a filled surface number Surf }
  18.  
  19. var Npts: integer;               { #points on edges of the surface }
  20.     Nextpt: integer;             { Next point to use for filling }
  21.     Node1, Node2: integer;       { node numbers of endpts of line }
  22.     Xpt, Ypt: points;            { pts on edges of surface }
  23.     Vert: integer;               { vertex number }
  24.     Pcolor: integer;             { actual color to plot with }
  25.     Fmod: integer;               { mod for filling function }
  26.     Ishade: integer;             { int version of shade (0..16) }
  27.  
  28. begin
  29. {$ifdef BIGMEM}
  30. with ptrd^ do with ptre^ do with ptrh^ do with ptri^ do
  31. begin
  32. {$endif}
  33.   if (onscreen (Surf)) then begin
  34.     if (Ncolors >= 3) and (Mono) then
  35.       { use system's colors as shades of grey }
  36.       colormod (Shade, GrSys, Color, Pcolor, Fmod)
  37.     else begin
  38.       { use dithered shading }
  39.       Ishade := trunc (Shade * 16.0);
  40.       Pcolor := Color;
  41.     end;
  42.  
  43.     Npts := 0;
  44.     for Vert := 1 to Nvert[Surf]-1 do begin
  45.       Node1 := Konnec (Surf, Vert);
  46.       Node2 := Konnec (Surf, Vert+1);
  47.       storline (round(Xtran[Node1]), round(Ytran[Node1]),
  48.                 round(Xtran[Node2]), round(Ytran[Node2]), Xpt, Ypt, Npts);
  49.       if (Npts < 0) then
  50.         badsurf;
  51.     end; { for Vert }
  52.  
  53. { One last line to close the polygon }
  54.     Node1 := Konnec (Surf, Nvert[Surf]);                    { last node }
  55.     Node2 := Konnec (Surf, 1);                          { first node }
  56.     storline (round(Xtran[Node1]), round(Ytran[Node1]),
  57.               round(Xtran[Node2]), round(Ytran[Node2]), Xpt, Ypt, Npts);
  58.     if (Npts < 0) then
  59.       badsurf;
  60.  
  61. { Sort the line segment points, first by Y, then by X }
  62.     shellpts (Xpt, Ypt, Npts);
  63.  
  64. { Now draw the filled surface }
  65.     Nextpt := 1;
  66.     if (Ncolors >= 3) and (Mono) then begin
  67.       { use system's colors as shades of grey }
  68.       while (Nextpt < Npts) do begin
  69.         if (abs(Xpt[Nextpt] - Xpt[Nextpt+1]) > 1) and
  70.            (Ypt[Nextpt] = Ypt[Nextpt+1]) then begin
  71.           shdraw (Xpt[Nextpt],Xpt[Nextpt+1],Ypt[Nextpt],Pcolor,Fmod);
  72.           Nextpt := Nextpt + 2;
  73.         end else begin
  74.           shplot (Xpt[Nextpt], Ypt[Nextpt], Pcolor, Fmod);
  75.           Nextpt := Nextpt + 1;
  76.         end;
  77.       end; { while }
  78.       if (Nextpt = Npts) then
  79.         shplot (Xpt[Nextpt], Ypt[Nextpt], Pcolor, Fmod);
  80.     end else begin
  81.       { use dithered shading }
  82.       while (Nextpt < Npts) do begin
  83.         if (abs(Xpt[Nextpt] - Xpt[Nextpt+1]) > 1) and
  84.            (Ypt[Nextpt] = Ypt[Nextpt+1]) then begin
  85.           dithdraw (Xpt[Nextpt],Xpt[Nextpt+1],Ypt[Nextpt],Ishade,Pcolor);
  86.           Nextpt := Nextpt + 2
  87.         end else begin
  88.           dithplot (Xpt[Nextpt],Ypt[Nextpt],Ishade,Pcolor);
  89.           Nextpt := Nextpt + 1
  90.         end;
  91.       end; { while }
  92.       if (Nextpt = Npts) then
  93.         dithplot (Xpt[Nextpt],Ypt[Nextpt],Ishade,Pcolor);
  94.     end; { if Ncolors... }
  95.   end; { if onscreen }
  96. {$ifdef BIGMEM}
  97. end; {with}
  98. {$endif}
  99. end; { procedure FILLSURF }
  100.